Figure 4

source("code/setup.R")
df <- read_csv("data/available_upon_request/whole_brain_data.csv")
df <- df |> mutate(dx=as.factor(dx))

roidf <- read_csv("data/available_upon_request/processed_ROI_data.csv") |> filter(dx==0)
roidfdx1 <- read_csv("data/available_upon_request/processed_ROI_data.csv") |> filter(dx==1)
ROI_Gcosinor <- read_rds("output/ROI_G-cosinor.rds")
ROI_Gcosinor_dx1 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_G-cosinor_dx1.rds")
ROI_Gcosinor_dx01 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_G-cosinor_dx01.rds")
ROI_AA <- read_rds("output/ROI_AA.rds")
ROI_AA_dx1 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_AA_dx1.rds")
ROI_AA_dx01 <- read_rds("output/ROI_cosinor_stats_BPD/ROI_AA_dx01.rds")
# Merge all stats used throughout
roi_sumtab <- Reduce(function(x, y, ...) merge(x, y, all = TRUE, ...),
                     list(ROI_Gcosinor |> select(measure,roi,p_gc = pvalue),
                          ROI_AA |> select(measure,roi,p_AA = p),
                          ROI_Gcosinor_dx1 |> select(measure,roi,p_gc_bpd = pvalue),
                          ROI_Gcosinor_dx01 |> select(measure,roi,p_gc_com = pvalue),
                          ROI_AA_dx1 |> select(measure,roi,p_AA_bpd = p),
                          ROI_AA_dx01 |> select(measure,roi,p_AA_com = p)))

# Whole brain statistics
WB_Gcosinor_dx0 <- read_rds("output/WB_G-cosinor.rds")
WB_Gcosinor_dx1 <- read_rds("output/WB_cosinor_stats_BPD/WB_G-cosinor_dx1.rds")
WB_Gcosinor_dx01 <- read_rds("output/WB_cosinor_stats_BPD/WB_G-cosinor_dx01.rds")
WB_AA <- read_rds("output/WB_AA.rds")
WB_AA_dx1 <- read_rds("output/WB_cosinor_stats_BPD/WB_AA_dx1.RDS")
WB_AA_dx01 <- read_rds("output/WB_cosinor_stats_BPD/WB_AA_dx01.RDS")
wb_sumtab <- list(
     WB_Gcosinor_dx0 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="CTRL"),
     WB_Gcosinor_dx1 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="BPD"),
     WB_Gcosinor_dx01 |> 
        select(measure,es=rsqdm,es2=rsq,pvalue) |> mutate(test="Gcos",grp="Combined"),
     WB_AA |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="CTRL",es2=NA),
     WB_AA_dx1 |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="BPD",es2=NA),
     WB_AA_dx01 |> 
        select(measure,es=chisq,pvalue=p) |> mutate(test="Fishers",grp="Combined",es2=NA)
     ) |> rbindlist(use.names = T) |> rename(p=pvalue)

bsc <- rbind(read_rds("output/WB_S-cosinor.rds") |> 
                mutate(dx=factor(0,levels=c(0,1))),
       read_rds("output/WB_cosinor_stats_BPD/WB_S-cosinor_dx1.rds"))
WB_acrodiffvar <- read_rds("output/WB_BPD_diffs/WB_acrodiffvar_test.RDS")

WB_Gcosinor  <- 
  WB_Gcosinor_dx1 |>
    select(amplitude,measure) |> 
    inner_join(WB_Gcosinor_dx1) |> 
    rename(acro_pcf = acrophase) |> 
    rename(p_pct = pvalue)

d2 <- 
    bsc |> 
    select(acro_sscf=acrophase,amp_sscf=amplitude,measure,p_ssct=pvalue,dx) |> 
    mutate(measure=factor(measure,levels = fig1_modord)) |> 
    arrange(measure)

plotdf <- WB_Gcosinor |> inner_join(d2,by="measure") |> 
    mutate(measure=factor(measure,levels = fig1_modord)) |> 
    arrange(measure)

Figure 4a: Polar

# Acrophase consistency
dxres <- 
    bsc |> 
    group_by(measure,dx) |> 
  summarize(cohort_resultant=acro2complex(acrophase) |> mean() |> abs(),
            cm = circamean(acrophase)) |>
  mutate(dxlab=dx2lab(dx)) |> 
  rbind(bsc |> 
    group_by(measure) |> 
  summarize(cohort_resultant=acro2complex(acrophase) |> mean() |> abs(),
            cm = circamean(acrophase),dxlab="Combined"))


diffacrovar_ms <- WB_acrodiffvar$measure[WB_acrodiffvar$p<0.05]
labmap <-
    WB_Gcosinor_dx0 |> ungroup() |> 
    arrange(match(measure,fig1_modord)) |>
    mutate(label=factor(measure,ordered=T,levels=fig1_modord,
                        labels = paste0(int2extlab[measure],
                                        ifelse(measure %in% diffacrovar_ms,
                                               "-Delta(abs(rho))-p<0.05","")
                                        ))) |>
    select(measure,label) |> unique() 

# (Partial) Source Data
fig4aSD <- 
  dxres |> 
  ungroup() |> 
  select(cohort_resultant,cm,dxlab,measure) |> 
  inner_join(
    rbind(
      WB_Gcosinor_dx0 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="CNTRL"),
      WB_Gcosinor_dx01 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="Combined"),
      WB_Gcosinor_dx1 |> 
        ungroup() |> 
        filter(pvalue<0.05) |> 
        select(measure,acrophase,acro_l,acro_u) |> 
        mutate(dxlab="BPD"))
  ) |> 
  mutate(measure=int2extlab[measure])
write_csv(fig4aSD,"output/source_data/Figure_4a_partial.csv")

Gcos_3grp_acrotick_p <- 
    plotdf |>
    inner_join(labmap) |> 
    ggplot(aes(acro_sscf,1-p_ssct))+
    ylab(expression(abs(rho)))+
    night_rect_early()+
    geom_rect(xmin=0,xmax=24,ymin=0,ymax=1,alpha=0.1,color=NA,fill="whitesmoke")+
    geom_rect(xmin=0,xmax=24,ymin=-Inf,ymax=0,fill="white")+
    geom_hline(yintercept = 1,color="black",size=0.2)+
    geom_hline(yintercept = 0.5,color="black",size=0.2,linetype=3)+
  annotate(geom="segment",x=seq(0,24,3),y=2.2,yend=0,xend=seq(0,24,3),
             color="grey90",size=0.3)+
    geom_text(aes(color=dx2lab(dx),y=1,
                  angle=-acro_sscf/24*360-90),
              size=5,label="-")+
    # G-cosinor dx1
    geom_point(data = plotdf |> filter(p_pct<0.05) |> inner_join(labmap),
               aes(acro_pcf,y=1.6,color=ifelse(p_pct<0.05,"BPD",NA)),size=1.2)+
    geom_errorbar(data = plotdf |> filter(p_pct<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u, xmax=acro_l,y=1.6,
                    color=ifelse(p_pct<0.05,"BPD",NA)),width=0.25)+
    # G-cosinor dx0
    geom_point(data = WB_Gcosinor_dx0 |> filter(pvalue<0.05) |> inner_join(labmap),
               aes(acrophase,y=1.3,color=ifelse(pvalue<0.05,"CNTRL",NA)),size=1.2)+
    geom_errorbar(data = WB_Gcosinor_dx0 |> filter(pvalue<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u,x=acrophase, 
                    xmax=acro_l,y=1.3, color=ifelse(pvalue<0.05,"CNTRL",NA)),width=0.25)+
    # G-cosinor dx0dx1
    geom_point(data = WB_Gcosinor_dx01 |> filter(pvalue<0.05) |> inner_join(labmap),
               aes(acrophase,y=1.9,color=ifelse(pvalue<0.05,"Combined",NA)),size=1.2)+
    geom_errorbar(data = WB_Gcosinor_dx01 |> filter(pvalue<0.05) |> inner_join(labmap),
                  aes(xmin=acro_u,x=acrophase, 
                    xmax=acro_l,y=1.9, color=ifelse(pvalue<0.05,"Combined",NA)),width=0.25)+
    geom_segment(data=dxres |> inner_join(labmap),
                 aes(xend=cm,x=cm,y=0,yend=cohort_resultant,color=dxlab),
                    size=0.5,alpha=0.8,
                 arrow = arrow(type = "closed",length = unit(0.8,"mm")))+
    scale_color_manual(values=c("BPD"=colors$dx1,
                                "CNTRL"=colors$dx0,
                                "Combined"=colors$dx01),guide='none')+
    facet_wrap(label~.,nrow=3,labeller = label_parsed)+
    theme(panel.border = element_blank(), 
          panel.background = element_blank(), 
          panel.grid = element_blank(),
          panel.spacing.x = unit(0,"line")) +
    coord_polar()+
    theme(panel.grid = element_blank())+
    theme(panel.spacing = unit(0, "lines"))+
    scale_y_continuous(breaks = c(0,1),limits = c(-0,2.2))+
  scale_x_continuous(limits = c(0,24), breaks=seq(0,24,6))+
  xlab("Acrophase (hr)")+
  theme_condense()+ theme(panel.border = element_blank(), 
                          panel.background = element_blank(),
                          #Legend
                          legend.title.align = 0,
                          legend.position = "right",
                          legend.title = element_text(size=8, vjust = 0, hjust = -3),
                          panel.spacing.x = unit(0.5,"line")
  )
Gcos_3grp_acrotick_p 

Spatial summary

Additional ROIs for combined Gcos

Extract stats referenced in text for “new” ROIs identified by combined (“FALSE TRUE”).

G-cosinor

roi_sumtab |> 
  group_by(measure) |> 
  mutate(class=paste(p.adjust(p_gc,"fdr")<0.05,p.adjust(p_gc_com,"fdr")<0.05)) |> 
  group_by(measure,class) |> count() |> 
  filter(class=="FALSE TRUE")

# A tibble: 3 × 3
# Groups:   measure, class [3]
  measure class          n
  <chr>   <chr>      <int>
1 cbf     FALSE TRUE    17
2 fa      FALSE TRUE     8
3 gm_md   FALSE TRUE   117

AA

roi_sumtab |> 
  group_by(measure) |> 
  mutate(class=paste(p.adjust(p_AA,"fdr")<0.05,
                     p.adjust(p_AA_com,"fdr")<0.05)) |> 
  group_by(measure,class) |> count() |> 
  filter(class=="FALSE TRUE")

# A tibble: 4 × 3
# Groups:   measure, class [4]
  measure class          n
  <chr>   <chr>      <int>
1 cbf     FALSE TRUE   119
2 gm_md   FALSE TRUE   101
3 md      FALSE TRUE     2
4 qt1     FALSE TRUE    93

Or the simple difference in #ROIs

roi_sumtab |> 
  group_by(measure) |> 
  summarize(n_gc=sum(p.adjust(p_gc,"fdr")<0.05),
            n_gc_com=sum(p.adjust(p_gc_com,"fdr")<0.05),
            n_AA=sum(p.adjust(p_AA,"fdr")<0.05),
            n_AA_com=sum(p.adjust(p_AA_com,"fdr")<0.05)) |> 
  mutate(diff_gc=n_gc_com-n_gc,
         diff_AA=n_AA_com-n_AA)

# A tibble: 9 × 7
  measure  n_gc n_gc_com  n_AA n_AA_com diff_gc diff_AA
  <chr>   <int>    <int> <int>    <int>   <int>   <int>
1 cbf       289      265   128      246     -24     118
2 ct          0        0     0        0       0       0
3 fa          0        8     0        0       8       0
4 gm_md      53      168    36      136     115     100
5 md          3        0     1        3      -3       2
6 qt1         0        0     4       97       0      93
7 sa          0        0     0        0       0       0
8 vol         0        0     0        0       0       0
9 wm_qt1      0        0     0        0       0       0

All

library(ggseg)
library(ggsegGlasser)
meta <- get_glasser_spatial_meta()
predat <- roi_sumtab |> 
    pivot_longer(c(p_gc,p_AA,p_AA_bpd,
                  p_AA_com,p_gc_bpd,p_gc_com)) |> 
    group_by(name,measure) |> 
    mutate(q=p.adjust(value,"fdr")) |> 
    mutate(name=factor(c("p_gc"="CNTRL Gcos",
                  "p_AA"="CNTRL Fishers",
                  "p_gc_bpd"="BPD Gcos",
                  "p_AA_bpd"="BPD Fishers",
                  "p_AA_com"="Combined Fishers",
                  "p_gc_com"="Combined Gcos")[name],
                  levels=c("CNTRL Gcos","CNTRL Fishers",
                         "BPD Fishers","BPD Gcos",
                         "Combined Fishers","Combined Gcos"),
                  labels = c("CNTRL Gcos (n=16)","CNTRL Fishers (n=16)",
                         "BPD Fishers (n=8)","BPD Gcos (n=8)",
                         "Combined Fishers (n=24)","Combined Gcos (n=24)"))) |> 
    group_by(measure,name) |> 
    mutate(n=sum(q<0.05),ntot=n()) |> 
    filter(n>0) |>
    mutate(value=ifelse(q<0.05,value,NA))

# Don't forget about these
predat |> 
    select(n,ntot,name,measure) |> 
    unique() |> 
    filter(measure %in% c("wm_qt1","fa","md"))

# A tibble: 5 × 4
# Groups:   measure, name [5]
      n  ntot name                    measure
  <int> <int> <fct>                   <chr>  
1     5    46 BPD Gcos (n=8)          fa     
2     8    46 Combined Gcos (n=24)    fa     
3     3    46 CNTRL Gcos (n=16)       md     
4     1    46 CNTRL Fishers (n=16)    md     
5     3    46 Combined Fishers (n=24) md     

Regional Highlights

Combined GM-MD

library(ggsegGlasser)
library(ggseg)
meta <- get_glasser_spatial_meta()
meta_glass <- get_glasser_spatial_meta()

fig4bSD <- 
  ROI_Gcosinor_dx01 |> 
    filter(measure =="gm_md") |> 
    mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,qvalue,acrophase)
write_csv(fig4bSD |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4b_part1.csv")

gmmdcombgc <- 
  inner_join(fig4bSD,meta) |>
    ggplot(aes(fill=acrophase))+
    facet_wrap(~int2extlab[measure],nrow=5)+
    theme_condense()+
    scale_fill_clock(rot=15,na.value="grey95")+
    geom_brain(atlas = glasser,
               position=position_brain(side ~ hemi),
               color="grey",size=0.1)+
    theme_void()
gmmdcombgc

WM-FA

# WM-FA Gcos comb
library(ggsegICBM)
library(plotly)
library(ggseg3d)
meta <- get_icbm_spatial_meta()

# Source Data
fig4bSD2 <- 
  ROI_Gcosinor_dx01 |> 
  filter(measure=="fa") |> 
  mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,qvalue,acrophase)
write_csv(fig4bSD2 |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4b_part2.csv")

pdf2 <- inner_join(fig4bSD2,meta) |> icbm_preprocess()
pdf2$region %in% icbm_3d$ggseg_3d[[1]]$region

 [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[21] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[41] TRUE TRUE TRUE TRUE TRUE

rot=15
pal <- 1:24
names(pal) <- rainbow(24)[((1:24)-1+rot)%%24+1]

p3d <- pdf2 |>  
    select(region,acrophase,roi) |> 
    ggseg3d(atlas = icbm_3d,colour="acrophase",
            palette = pal,na.alpha = 0.01) |> 
    add_glassbrain(opacity=0.05) |>
    pan_camera("right lateral") |>
    remove_axes()
p3d

GM-qT1 (AA)

ROI_Scosinor <- read_rds("output/ROI_cosinor_stats_BPD/ROI_S-cosinor_dx01.rds") |> unnest(bsc)
sigrois <- ROI_AA_dx01 |> 
  filter(measure=="qt1") |> 
  filter(q<0.05) |> 
  pull(roi)

# Source Data
fig4cSD <-
  ROI_Scosinor |>   
  filter(measure=="qt1") |> 
  group_by(measure,roi) |>
  summarize(var=1-acrophase |> acro2complex() |> mean() |> abs()) |> 
  mutate(var=ifelse((roi %in% (sigrois)),var,NA))
  # filter(roi %in% (sigrois))  
write_csv(fig4cSD |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_4c.csv")

gmqt1combaa <-
  fig4cSD |> 
  inner_join(meta_glass) |>  
  ggplot(aes(fill=var))+
  facet_grid(measure~.)+
  theme_condense()+
  scale_fill_gradientn(colours = c("blue","#C26179"),
                       na.value="grey95",limits=c(0,1))+
  guides(colour = guide_coloursteps(show.limits = TRUE))+
  labs(fill="Acrophase Variance")+
  geom_brain(atlas = glasser,
             position=position_brain(side ~ hemi),color="grey50",size=0.05)+
  theme_void()+
  geom_text(aes(x=320,y=220,
                label=paste0(length(sigrois),"/",nrow(ROI_AA_dx01 |> filter(measure=="qt1")))),size=3)+
  theme(panel.background = element_rect(color="grey80",size=0.1))+
  theme(panel.spacing.x = unit(0, "lines"))+
  theme(panel.spacing.y = unit(0, "lines"))
gmqt1combaa

Subcortical

GM-MD

myaseg <- get_subcor_ggseg_atlas()
# Used to remove
meta <- get_glasser_spatial_meta()

# gmmdcombgc <- 
fig4bSD |> 
  full_join(meta) |> 
    filter(measure =="gm_md") |>  
  mutate(acrophase=ifelse(qvalue<0.05,acrophase,NA)) |> 
  filter(is.na(`z-cog`)) |>  # To remove non-subcortical 
  rename(label=roi) |> #pull(label)
  filter(qvalue<0.05) |> #dim
  select(label,qvalue,acrophase) |> 
  ggplot(aes(fill=acrophase))+
  theme_condense()+
  geom_brain(atlas = myaseg)+
    scale_fill_clock(rot=15,na.value="grey95")+
    facet_wrap(~int2extlab[measure],nrow=5)+
    theme_condense()+
  theme_void()

GM-qT1

meta <- get_glasser_spatial_meta()

# GM-qT1
fig4cSD |> 
  full_join(meta) |> 
  filter(is.na(`z-cog`)) |>  # To remove non-subcortical
  rename(label=roi) |> 
  select(label,var) |> 
  ggplot(aes(fill=var))+
  theme_condense()+
  scale_fill_gradientn(colours = c("blue","#C26179"),
                       na.value="grey95",limits=c(0,1))+
  geom_brain(atlas = myaseg)+
  theme_void()

Scaled Curves

tmp <- bsc |> filter(measure=="cbf")
acros <- seq(8,33,length.out=100)[-1]

ddf <- 
bsc |> 
    filter(measure=="cbf" | measure=="gm_md") |> 
  group_by(dx,measure) |> 
  nest() |> 
  mutate(ddf=map(data,function(tmp){
    par <- circular::mle.vonmises(circular::circular(tmp$acrophase/24*2*pi))
    data.frame(acros,
             dens=circular::dvonmises(circular::circular(acros/24*2*pi),
                            circamean(tmp$acrophase)/24*2*pi,
                            par$kappa))
})) |> select(-data) |> unnest(ddf) |> 
  mutate(dens=ifelse(measure=="cbf",dens*20/2+20,dens*0.0015/2+0.0015))

curv_and_dist_p2_comb <- 
    ggplot()+
    night_rect()+
  geom_line(data=bsc |>
              filter(measure=="cbf" | measure=="gm_md") |> 
              mutate(value=map2(amplitude,acrophase,cosinor_pred,time=9:33),
                     ltime=list(9:33)) |>
              unnest(c(value,ltime)),
            aes(ltime,value,group=subject,color=dx2lab(dx)),size=0.4,alpha=0.4)+
  geom_line(data=WB_Gcosinor_dx0 |> mutate(dx=0) |> 
              rbind(WB_Gcosinor_dx1 |> mutate(dx=1)) |> 
              filter(measure=="cbf" | measure=="gm_md") |> 
              mutate(value=map2(amplitude,acrophase,cosinor_pred,time=9:33),
                     ltime=list(9:33)) |>
              unnest(c(value,ltime)),
            aes(ltime,value,color=dx2lab(dx)),size=1.5)+
  # Densities
  geom_ribbon(data=ddf,
              aes(acros,y=1,ymax=dens,group=NA,
                  ymin=ifelse(measure=="cbf",20,0.0015)),
              alpha=0.6)+
    geom_point(data=bsc |> 
                 filter(measure=="cbf" | measure=="gm_md"),
              aes(ifelse(acrophase<8,acrophase+24,acrophase),group=NA,color=dx2lab(dx),
               y=ifelse(measure=="cbf",20,0.0015)*1.1),
              shape="l",size=4,alpha=0.7)+
  facet_grid(int2extlab[measure]~dx2lab(dx),scales="free",labeller = label_parsed)+
    scale_color_manual(values=c("BPD"=colors$dx1,
                                "CNTRL"=colors$dx0,
                                "Combined"=colors$dx01),guide='none')+
  scale_x_continuous(breaks = seq(8,32,4),labels = seq(8,32,4%%24))+
    ylab("Cosinor predicted values")+
    xlab("Time of Day (hr)")+
    theme_condense()
curv_and_dist_p2_comb 

Figure 4e TOD effects

allres <- 
    df |> 
  filter(measure=="cbf" | measure=="gm_md") |> 
    group_by(measure) |> nest() |> 
    mutate(res=map(data,function(x){
      lapply(1:9,function(ss1){
        ss2=ss1
        tdf <- x |> filter((session==ss1 & dx==0) | (session==ss2 & dx==1))
        res <- t.test(tdf$value[tdf$dx==1],tdf$value[tdf$dx==0])
        res |> glance() |> mutate(ss1,ss2)
      }) |> rbindlist() 
    })) |> unnest(res) 

# Source Data
fig4eSD <- 
  allres |> 
  select(session=ss1,estimate,measure) |> 
  mutate(tod=(session-1)*3+9) |> 
  mutate(measure=int2extlab[measure])
write_csv(fig4eSD,"output/source_data/Figure_4e.csv")

TODestimate_p_comb <- 
  fig4eSD |> 
  ggplot(aes(tod,estimate))+
  geom_col()+
  stat_smooth_cosinor(size=2,fullrange=TRUE)+
  xlab("Time of Day [hr] \n(session #)")+
  ylab("BPD - CNTRL")+
  # Linear order but ToD labels
  scale_x_continuous(breaks=seq(9,36,3),
                     labels = paste0(seq(9,36,3)%%24,"\n(",seq(1,9),")"))+
  facet_grid(measure~.,scales="free")+
    geom_hline(yintercept = 0)+
  theme_condense()
TODestimate_p_comb

Final Figure 4

Gcos_3grp_acrotick_p+labs(color="Group")+theme_condense_legend()+
  #
  gmmdcombgc+theme(legend.position="none")+ 
  theme(strip.text = element_text(size=6,color="black",
                                  margin = margin( b = 0, t = 0)))+
  gmqt1combaa+
  guides(fill = guide_colorbar(override.aes = list(size = 0.3)))+
  theme(legend.title = element_text(size = 6), 
        legend.text = element_text(size = 6),
        legend.key.size = unit(0.3, 'cm'))+
  theme(strip.text = element_text(size=6,color="black",
                                  margin = margin( b = 0, t = 0)))+
  #
  curv_and_dist_p2_comb+theme(legend.position="none")+
  #
  TODestimate_p_comb+
  #
  guide_area()+
  #-patchwork
  plot_layout(design = "
                    AAAAABBB
                    AAAAABBB
                    AAAAABBB
                    AAAAACCC
                    AAAAACCC
                    AAAAACCC
                    DDDE#FFF
                    DDDEGGGG")+
  plot_annotation(tag_levels = 'a')+
  plot_layout(guides = 'collect')

---

Click to see page metadata

Computation Started: 2023-10-11 20:00:47

Finished in 40.579 secs

---

Git Log

No git history available for this page

---

Packages

package	version	date
readxl	1.4.1	2023-10-10
backports	1.4.1	2023-10-10
systemfonts	1.0.4	2023-10-10
plyr	1.8.8	2023-10-10
lazyeval	0.2.2	2023-10-10
splines	4.1.3	2023-06-16
shinydashboard	0.7.2	2023-10-10
crosstalk	1.2.0	2023-10-10
GenomeInfoDb	1.30.1	2023-10-10
ggplot2	3.4.0	2023-10-10
digest	0.6.31	2023-10-10
foreach	1.5.2	2023-10-10
ca	0.71.1	2023-10-10
htmltools	0.5.4	2023-10-10
viridis	0.6.2	2023-10-10
magick	2.7.3	2023-10-10
fansi	1.0.4	2023-10-10
magrittr	2.0.3	2023-10-10
googlesheets4	1.0.1	2023-10-10
tzdb	0.3.0	2023-10-10
readr	2.1.3	2023-10-10
modelr	0.1.10	2023-10-10
matrixStats	0.63.0	2023-10-10
methods	4.1.3	2023-06-16
vroom	1.6.1	2023-10-10
svglite	2.1.1	2023-10-10
timechange	0.2.0	2023-10-10
colorspace	2.1-0	2023-10-10
rvest	1.0.3	2023-10-10
ggsegGlasser	1.0.01	2023-10-10
haven	2.5.1	2023-10-10
xfun	0.37	2023-10-10
dplyr	1.1.0	2023-10-10
crayon	1.5.2	2023-10-10
RCurl	1.98-1.10	2023-10-10
jsonlite	1.8.4	2023-10-10
iterators	1.0.14	2023-10-10
glue	1.6.2	2023-10-10
ggsegICBM	1.0.1	2023-10-10
kableExtra	1.3.4	2023-10-10
registry	0.5-1	2023-10-10
utils	4.1.3	2023-06-16
gtable	0.3.1	2023-10-10
gargle	1.3.0	2023-10-10
zlibbioc	1.40.0	2023-10-10
XVector	0.34.0	2023-10-10
webshot	0.5.4	2023-10-10
UpSetR	1.4.0	2023-10-10
DelayedArray	0.20.0	2023-10-10
BiocGenerics	0.40.0	2023-10-10
scales	1.2.1	2023-10-10
mvtnorm	1.1-3	2023-10-10
futile.options	1.0.1	2023-10-10
DBI	1.1.3	2023-10-10
graphics	4.1.3	2023-06-16
miniUI	0.1.1.1	2023-10-10
Rcpp	1.0.10	2023-10-10
viridisLite	0.4.1	2023-10-10
xtable	1.8-4	2023-10-10
units	0.8-2	2023-10-10
proxy	0.4-27	2023-10-10
bit	4.0.5	2023-10-10
stats4	4.1.3	2023-06-16
DT	0.27	2023-10-10
base	4.1.3	2023-06-16
htmlwidgets	1.6.1	2023-10-10
httr	1.4.4	2023-10-10
RColorBrewer	1.1-3	2023-10-10
ellipsis	0.3.2	2023-10-10
farver	2.1.1	2023-10-10
pkgconfig	2.0.3	2023-10-10
dbplyr	2.3.0	2023-10-10
utf8	1.2.3	2023-10-10
here	1.0.1	2023-10-10
labeling	0.4.2	2023-10-10
tidyselect	1.2.0	2023-10-10
rlang	1.0.6	2023-10-10
reshape2	1.4.4	2023-10-10
later	1.3.0	2023-10-10
stats	4.1.3	2023-06-16
munsell	0.5.0	2023-10-10
cellranger	1.1.0	2023-10-10
tools	4.1.3	2023-06-16
cli	3.6.0	2023-10-10
generics	0.1.3	2023-10-10
broom	1.0.3	2023-10-10
evaluate	0.20	2023-10-10
shinyBS	0.61.1	2023-10-10
stringr	1.5.0	2023-10-10
fastmap	1.1.0	2023-10-10
heatmaply	1.4.2	2023-10-10
yaml	2.3.7	2023-10-10
grDevices	4.1.3	2023-06-16
bit64	4.0.5	2023-10-10
knitr	1.42	2023-10-10
fs	1.6.1	2023-10-10
shinycssloaders	1.0.0	2023-10-10
zip	2.2.2	2023-10-10
purrr	1.0.1	2023-10-10
dendextend	1.16.0	2023-10-10
nlme	3.1-162	2023-10-10
DiscoRhythm	1.10.1	2023-10-10
mime	0.12	2023-10-10
formatR	1.14	2023-10-10
ggExtra	0.10.0	2023-10-10
xml2	1.3.3	2023-10-10
BiocStyle	2.22.0	2023-10-10
compiler	4.1.3	2023-06-16
rstudioapi	0.14	2023-10-10
plotly	4.10.1	2023-10-10
e1071	1.7-13	2023-10-10
reprex	2.0.2	2023-10-10
tibble	3.1.8	2023-10-10
stringi	1.7.12	2023-10-10
highr	0.10	2023-10-10
futile.logger	1.4.3	2023-10-10
forcats	1.0.0	2023-10-10
circular	0.4-95	2023-10-10
lattice	0.20-45	2023-06-16
Matrix	1.5-1	2023-10-10
classInt	0.4-9	2023-10-10
shinyjs	2.1.0	2023-10-10
vctrs	0.5.2	2023-10-10
ggseg3d	1.6.3	2023-10-10
pillar	1.8.1	2023-10-10
lifecycle	1.0.3	2023-10-10
BiocManager	1.30.19	2023-10-10
data.table	1.14.6	2023-10-10
bitops	1.0-7	2023-10-10
seriation	1.4.1	2023-10-10
httpuv	1.6.8	2023-10-10
patchwork	1.1.2	2023-10-10
GenomicRanges	1.46.1	2023-10-10
R6	2.5.1	2023-10-10
promises	1.2.0.1	2023-10-10
TSP	1.2-2	2023-10-10
renv	0.17.3	2023-10-11
KernSmooth	2.23-20	2023-06-16
gridExtra	2.3	2023-10-10
IRanges	2.28.0	2023-10-10
codetools	0.2-19	2023-10-10
lambda.r	1.2.4	2023-10-10
boot	1.3-28.1	2023-10-10
assertthat	0.2.1	2023-10-10
SummarizedExperiment	1.24.0	2023-10-10
rprojroot	2.0.3	2023-10-10
withr	2.5.0	2023-10-10
S4Vectors	0.32.4	2023-10-10
datasets	4.1.3	2023-06-16
GenomeInfoDbData	1.2.7	2023-10-10
mgcv	1.8-41	2023-10-10
parallel	4.1.3	2023-06-16
hms	1.1.2	2023-10-10
VennDiagram	1.7.3	2023-10-10
grid	4.1.3	2023-06-16
tidyverse	1.3.2	2023-10-10
class	7.3-21	2023-10-10
tidyr	1.3.0	2023-10-10
rmarkdown	2.20	2023-10-10
MatrixGenerics	1.6.0	2023-10-10
googledrive	2.0.0	2023-10-10
git2r	0.31.0	2023-10-10
sf	1.0-12	2023-10-10
ggseg	1.6.6	2023-10-10
Biobase	2.54.0	2023-10-10
shiny	1.7.4	2023-10-10
lubridate	1.9.1	2023-10-10

---

System Information

	systemInfo
version	R version 4.1.3 (2022-03-10)
platform	x86_64-pc-linux-gnu (64-bit)
locale	en_US.UTF-8
OS	Ubuntu 20.04.6 LTS
UI	X11

Scikick Configuration

cat scikick.yml

### Scikick Project Workflow Configuration File

# Directory where Scikick will store all standard notebook outputs
reportdir: report

# --- Content below here is best modified by using the Scikick CLI ---

# Notebook Execution Configuration (format summarized below)
# analysis:
#  first_notebook.Rmd:
#  second_notebook.Rmd:
#  - first_notebook.Rmd         # must execute before second_notebook.Rmd
#  - functions.R                # file is used by second_notebook.Rmd
#
# Each analysis item is executed to generate md and html files, E.g.:
# 1. <reportdir>/out_md/first_notebook.md
# 2. <reportdir>/out_html/first_notebook.html

analysis: !!omap
- code/methods/methods_walkthrough.Rmd:
- code/methods/Gcosinor_implementation_check.Rmd: []
- code/results/WB_S-cosinor.Rmd: []
- code/results/WB_G-cosinor.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/WB_acrophase_agnostic_tests.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/ROI_S-cosinor.Rmd: []
- code/results/ROI_G-cosinor.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/ROI_acrophase_agnostic_tests.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/body_weight.Rmd: []
- code/results/WB_cosinor_stats_BPD.Rmd: []
- code/results/ROI_cosinor_stats_BPD.Rmd: []
- code/results/WB_BPD_diffs.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/display_items/table_1.Rmd:
  - code/display_items/figure_S5_actigraphy.Rmd
  - code/results/body_weight.Rmd
- code/display_items/table_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/figure_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
- code/display_items/figure_3.Rmd:
  - code/results/ROI_S-cosinor.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/WB_G-cosinor.Rmd
- code/display_items/figure_4.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_BPD_diffs.Rmd
  - code/results/ROI_cosinor_stats_BPD.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/table_S1_techvar.Rmd:
- code/display_items/table_S3_adjweight.Rmd: []
- code/display_items/figure_S4_spatialG.Rmd:
  - code/results/ROI_G-cosinor.Rmd
- code/display_items/figure_S5_actigraphy.Rmd: []
- code/display_items/figure_S6_phasePSQI.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/index.Rmd:
  - README.md
snakefile_args:
  singularity: /external/EPIGENETICS/SCRATCH/automator/share/singularity/shared3.img
version_info:
  snakemake: 6.3.0
  ruamel.yaml: 0.16.5
  scikick: 0.2.0
# Optional site theme customization
output:
  BiocStyle::html_document:
    code_folding: show
    theme: readable
    toc_float: true
    toc: true
    number_sections: false
    toc_depth: 5
    self_contained: true

---

Functions

acro2complex

function (acro, per = 24) 
{
    z <- complex(real = cos(acro/per * 2 * pi), imaginary = sin(acro/per * 
        2 * pi))
    return(z)
}
<bytecode: 0x55c01fcccd50>

ampacro2cos

function (amp, acro, per = 24) 
amp * cos(acro/per * 2 * pi)

ampacro2sin

function (amp, acro, per = 24) 
amp * sin(acro/per * 2 * pi)

circamean

function (x, ...) 
{
    ret <- {
        function(x) (x * 24/(2 * pi))%%24
    }(Arg(mean(acro2complex(x))))
    return(ret)
}
<bytecode: 0x55c0200af250>

circdist

function (acro1, acro2, per = 24) 
{
    tmp <- (acro1 - acro2)%%per
    idx <- which(tmp > (per/2))
    tmp[idx] <- tmp[idx] - per
    return(tmp)
}

coord_circpolar

function (...) 
{
    list(coord_polar(...), scale_x_continuous(limits = c(0, 24), 
        breaks = seq(0, 24, 3)), scale_y_continuous(limits = c(-1, 
        NA)), theme(panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank(), 
        panel.grid.major.x = element_blank()), geom_hline(yintercept = 0, 
        color = "grey"))
}

cosinor_pred

function (time, A, acro, mesor = 0, per = 24) 
{
    mesor + A * cos((time - acro) * 2 * pi/per)
}
<bytecode: 0x55c02e99d708>

dcast

function (data, formula, fun.aggregate = NULL, ..., margins = NULL, 
    subset = NULL, fill = NULL, drop = TRUE, value.var = guess_value(data)) 
{
    formula <- parse_formula(formula, names(data), value.var)
    if (length(formula) > 2) {
        stop("Dataframes have at most two output dimensions")
    }
    if (!is.null(margins)) {
        data <- add_margins(data, lapply(formula, names), margins)
    }
    res <- cast(data, formula, fun.aggregate, ..., subset = subset, 
        fill = fill, drop = drop, value.var = value.var)
    data <- as.data.frame.matrix(res$data, stringsAsFactors = FALSE)
    names(data) <- array_names(res$labels[[2]])
    stopifnot(nrow(res$labels[[1]]) == nrow(data))
    cbind(res$labels[[1]], data)
}
<bytecode: 0x55c001c40840>
<environment: namespace:reshape2>

discoCosinor

function (x, zts, per = 24) 
{
    Y <- as.matrix(x)
    res <- lmCSmatNoNA(Y[NULL, ], zts, per)
    res[seq_len(nrow(Y)), ] <- NA
    obsinds <- t(!is.na(Y))
    obstypes <- unique(obsinds, MARGIN = 2)
    obstypes <- obstypes[, colSums(obstypes) > 2, drop = FALSE]
    for (i in seq_len(ncol(obstypes))) {
        inds <- colMeans(obsinds == obstypes[, i]) == 1
        res[inds, ] <- lmCSmatNoNA(Y[inds, obstypes[, i], drop = FALSE], 
            zts[obstypes[, i]], per)
    }
    res
}
<bytecode: 0x55c0150d7420>
<environment: namespace:DiscoRhythm>

discoPMcos

function (x, period = 24, idname = NULL, alpha = 0.05) 
{
    if (is.data.frame(x)) 
        x <- split(x, 1:nrow(x))
    isdup <- F
    if (nrow(x[[1]]) == 1) {
        isdup <- T
        x <- lapply(x, function(y) rbind(y, y))
    }
    betas <- sapply(x, function(a) a$sincoef)
    gammas <- sapply(x, function(a) a$coscoef)
    mesors <- sapply(x, function(a) a$mesor)
    beta <- rowMeans(betas)
    gamma <- rowMeans(gammas)
    MESOR <- rowMeans(mesors)
    amplitude <- sqrt(beta^2 + gamma^2)
    acrophase_rad <- atan2(beta, gamma)
    sdm <- matrixStats::rowSds(mesors)
    sdb <- matrixStats::rowSds(betas)
    sdy <- matrixStats::rowSds(gammas)
    covby <- diag(cov(t(betas), t(gammas)))
    k <- ncol(betas)
    denom <- amplitude^2 * k
    c22 <- (sdb^2 * beta^2 + 2 * covby * beta * gamma + sdy^2 * 
        gamma^2)/denom
    c23 <- ((-1 * (sdb^2 - sdy^2)) * (beta * gamma) + covby * 
        (beta^2 - gamma^2))/denom
    c33 <- (sdb^2 * gamma^2 - 2 * covby * beta * gamma + sdy^2 * 
        beta^2)/denom
    t <- abs(qt(alpha/2, df = k - 1))
    mesoru <- MESOR + ((t * sdm)/sqrt(k))
    mesorl <- MESOR - ((t * sdm)/sqrt(k))
    ampu <- amplitude + (t * sqrt(c22))
    ampl <- amplitude - (t * sqrt(c22))
    tmp <- vapply(seq_along(ampu), function(i) {
        if (ampu[i] > 0 & ampl[i] < 0) {
            return(c(NA, NA))
        }
        dn <- amplitude[i]^2 - c22[i] * t^2
        crit <- t * sqrt(c33[i]) * sqrt(amplitude[i]^2 - (c22[i] * 
            c33[i] - c23[i]^2) * (t^2/c33[i]))
        return(c(acrophase_rad[i] + atan((c23[i] * t^2 + crit)/dn), 
            acrophase_rad[i] + atan((c23[i] * t^2 - crit)/dn)))
    }, numeric(2))
    fiu <- tmp[1, ]
    fil <- tmp[2, ]
    r <- diag(cor(t(betas), t(gammas)))
    frac1 <- (k * (k - 2))/(2 * (k - 1))
    frac2 <- 1/(1 - r^2)
    frac3 <- beta^2/sdb^2
    frac4 <- (beta * gamma)/(sdb * sdy)
    frac5 <- gamma^2/sdy^2
    brack <- frac3 - 2 * r * frac4 + frac5
    Fvalue <- frac1 * frac2 * brack
    df2 <- k - 2
    pvalue <- pf(q = Fvalue, df1 = 2, df2 = df2, lower.tail = F)
    ret <- data.frame(F = Fvalue, df1 = 2, df2 = k - 2, pvalue, 
        qvalue = p.adjust(pvalue, "fdr"), MESOR, amplitude = amplitude, 
        acrophase = (acrophase_rad/2/pi * period + period)%%period, 
        MESOR_l = mesorl, MESOR_u = mesoru, amp_l = ampl, amp_u = ampu, 
        acro_l = (fil/2/pi * period + period)%%period, acro_u = (fiu/2/pi * 
            period + period)%%period)
    idx <- which(ret$acro_l > ret$acro_u)
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    idx <- which((ret$acro_l < ret$acro & ret$acro_u < ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] + period
    ret$acro_u[idx] <- ret$acro_u[idx] + period
    idx <- which((ret$acro_l > ret$acro & ret$acro_u > ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    ret$acro_u[idx] <- ret$acro_u[idx] - period
    if (!is.null(idname)) {
        rownames(ret) <- x[[1]][[idname]]
    }
    else {
        rownames(ret) <- rownames(x[[1]])
    }
    if (isdup) 
        ret <- ret[1, ]
    return(ret)
}

dx2lab

function (x) 
{
    return(ifelse(as.character(x) == "1", "BPD", "CNTRL"))
}
<bytecode: 0x55c020593bf8>

geom_smooth_cosinor

function (...) 
geom_smooth(method = "lm", formula = y ~ sinpi(x/12) + cospi(x/12), 
    ...)

get_glasser_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/MMP1_CSV_file.xlsx")
    meta <- meta %>% mutate(region = ifelse(region == "7Pl", 
        "7PL", region)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_L", "7PL_L", regionName)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_R", "7PL_R", regionName))
    meta$roi <- paste(meta$LR, gsub("_[LR]", "", meta$regionName), 
        "ROI", sep = "_")
    meta$hemi <- ifelse(meta$LR == "L", "left", "right")
    return(meta)
}
<bytecode: 0x55c0213ce5a0>

get_icbm_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/JHU_ICBM81.xlsx")
    meta <- meta[-c(1:2), ]
    meta$region <- meta$label %>% gsub(" ", "_", .) %>% gsub("\\(", 
        "", .) %>% gsub("\\)", "", .) %>% gsub("\\/", "or", .)
    meta$roi <- meta$region
    meta <- meta %>% mutate(region = gsub(" R$", "", label)) %>% 
        mutate(region = gsub(" L$", "", region)) %>% filter(region != 
        "Unclassified")
    return(meta)
}
<bytecode: 0x55c025f4f0e8>

get_subcor_ggseg_atlas

function () 
{
    library(ggseg)
    library(ggsegGlasser)
    meta <- get_glasser_spatial_meta()
    pdf <- full_join(unique(select(read_csv("data/available_upon_request/processed_ROI_data.csv") %>% 
        filter(measure == "cbf"), roi)), meta) %>% filter(is.na(`z-cog`)) %>% 
        rename(label = roi) %>% ungroup() %>% select(label)
    myaseg <- aseg
    myaseg$data <- myaseg$data %>% filter(label %in% pdf$label)
    return(myaseg)
}
<bytecode: 0x55c01b94d708>

groupWiseSummaryPvalTable

function (dat, as_kable = FALSE) 
{
    ret <- dat %>% group_by(grp) %>% summarize(res = list(summaryPvalTable(pvalue))) %>% 
        unnest(res) %>% mutate(val = paste0(percent, " (", count, 
        ")")) %>% reshape2::dcast(level ~ grp, value.var = "val")
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

icbm_preprocess

function (df) 
{
    df %>% filter(region != "Fornix (column and body of fornix)") %>% 
        mutate(roi = str_pad(index, 3, pad = "0"))
}

my_val_formatter

function (x, doparse = T, mf = T, ...) 
{
    ifelse(x > 10000 | (x > 0 & x < 0.001) | (x < 0 & x > -0.001), 
        {
            txt1 <- (scales::scientific_format(digits = 2))(x)
            if (mf) {
                txt <- gsub("e\\+*", " %*% 10^", txt1)
            }
            else {
                return(txt1)
            }
            if (doparse) {
                return(parse(text = txt))
            }
            else {
                return(txt)
            }
        }, formatC(x, format = "fg", digits = 2, flag = "#", 
            big.mark = ","))
}

myfmt

function (x) 
formatC(x, digits = 2)

myfmt2

function (x) 
my_val_formatter(x, mf = F)

night_rect

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 24, 
        xmax = 32, alpha = 0.8, fill = "grey", color = NA)
}

night_rect_early

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 0, 
        xmax = 8, alpha = 0.8, fill = "grey", color = NA)
}

night_recty

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 24, 
        ymax = 32, alpha = 0.8, fill = "grey", color = NA)
}

night_recty_early

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 0, 
        ymax = 8, alpha = 0.8, fill = "grey", color = NA)
}

pqlabs

function (p = NULL, q = NULL) 
{
    if (!is.null(p) & is.null(q)) {
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        levs <- c("p>0.05", "p<0.05")
    }
    else if (is.null(p) & !is.null(q)) {
        lab <- rep("q>0.05", length(q))
        lab[q < 0.05] <- "q<0.05"
        levs <- c("q>0.05", "q<0.05")
    }
    else if (!is.null(p) & !is.null(q)) {
        stopifnot(length(p) == length(q))
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        lab[q < 0.05] <- "q<0.05"
        levs <- c("p>0.05", "p<0.05", "q<0.05")
    }
    return(factor(lab, levels = levs))
}

rsqGcos

function (pmr, dat) 
{
    predat2 <- group_by(mutate(group_by(inner_join(pmr, dat), 
        measure, roi, subject), dmval = value - mean(value)), 
        measure, roi)
    rsqdf <- summarize(mutate(mutate(mutate(mutate(predat2, sr1 = (value - 
        cosinor_pred(time, amplitude, acrophase, MESOR))^2), 
        ts1 = (value - MESOR)^2), sr2 = (dmval - cosinor_pred(time, 
        amplitude, acrophase, 0))^2), ts2 = (dmval - 0)^2), rsq = 1 - 
        sum(sr1)/sum(ts1), rsqdm = 1 - sum(sr2)/sum(ts2))
    return(inner_join(pmr, rsqdf))
}

scale_alpha_fgbg

function (alpha_bg = 0.3, ...) 
scale_alpha_manual(values = c(`TRUE` = 1, `FALSE` = alpha_bg, 
    ...))

scale_color_clock

function (rot = 0, ...) 
scale_color_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)

scale_color_dx

function () 
{
    scale_color_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_color_dxlab

function (...) 
{
    scale_color_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0, 
        ...))
}

scale_color_fgbg

function (fgcol = "red", ...) 
scale_color_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_fill_clock

function (rot = 0, ...) 
scale_fill_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)
<bytecode: 0x55c021580cb8>

scale_fill_dx

function () 
{
    scale_fill_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_fill_dxlab

function () 
{
    scale_fill_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0))
}

scale_fill_fgbg

function (fgcol = "red", ...) 
scale_fill_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_x_circ

function () 
scale_x_continuous(limits = c(0, 24), breaks = seq(0, 24, 6))

session_is_day2

function (session, time) 
{
    (session >= 6 & session <= 9) & time < 12
}

sincos2acro

function (sin, cos, per = 24) 
{
    (atan2(sin, cos)/2/pi * per + per)%%per
}
<bytecode: 0x55c0150cd0d8>
<environment: namespace:DiscoRhythm>

sincos2amp

function (sin, cos) 
sqrt(sin^2 + cos^2)
<bytecode: 0x55c0150ce9d8>
<environment: namespace:DiscoRhythm>

stat_smooth_cosinor

function (...) 
stat_smooth(geom = "line", method = "lm", formula = y ~ sinpi(x/12) + 
    cospi(x/12), ...)

summaryPvalTable

function (p, as_kable = FALSE) 
{
    ps <- list()
    ps[[1]] <- p < 0.05
    ps[[2]] <- p < 0.01
    ps[[3]] <- p.adjust(p, method = "fdr") < 0.05
    ps[[4]] <- p.adjust(p, method = "bonferroni") < 0.05
    levs <- c("p < 0.05", "p < 0.01", "FDR", "Bonferroni")
    perc <- sapply(ps, function(p) round(mean(p, na.rm = TRUE), 
        4)) * 100
    sums <- sapply(ps, function(p) sum(p, na.rm = TRUE))
    ret <- data.frame(level = levs, count = sums, percent = paste0(perc, 
        "%"), stringsAsFactors = FALSE)
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

theme_condense

function () 
{
    list(theme(strip.background = element_rect(color = "white", 
        fill = "white")), theme(strip.text = element_text(size = 7, 
        color = "black", margin = margin(b = 0, t = 0))), theme(axis.text = element_text(size = 7)))
}
<bytecode: 0x55c010559e78>

theme_condense_legend

function () 
{
    list(guides(shape = guide_legend(override.aes = list(size = 0.3))), 
        guides(color = guide_legend(override.aes = list(size = 0.3))), 
        guides(fill = guide_legend(override.aes = list(size = 0.3))), 
        theme(legend.title = element_text(size = 6), legend.text = element_text(size = 6), 
            legend.key.size = unit(0.3, "cm")))
}

Next (Project Map)

---